home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr35 / qwkblt12.zip / QWK-BLT.PPS < prev   
Text File  |  1993-05-27  |  7KB  |  273 lines
  1. ;────── QWK-BLT.PPS ─────────────────────────────────────────────────────────
  2. ;
  3. ;       Version 1.30
  4. ;       May 26, 1994
  5. ;       Copyright 1993, James Dean Jones
  6. ;
  7. ;       Attach new main board bulletins to internally generated .QWK packets
  8. ;
  9. ; Sure would be nice if the PPLC supported random access files (hint)
  10. ;   ... or ... if they do, someone PLEASE tell me
  11. ;
  12. ;       2/3 Board
  13. ;       (217) 877-1138
  14. ;       16.8k Dual Standard
  15. ;
  16. ;────────────────────────────────────────────────────────────────────────────
  17.  
  18. ;────── Variables ───────────────────────────────────────────────────────────
  19.  
  20. string  cnames      ; path of CNAMES file
  21. string  bltlst      ; path of main board bulletin list
  22. string  cmdline     ; command line to return to PCBoard
  23. string  token       ; individual command
  24. string  bltpth      ; path to bulletin
  25. string  nbltpth     ; path of temporary copy of bulletin
  26. string  bltscan     ; list of bulletins to scan
  27. string  line        ; line of text from bulletin list file
  28. string  parseln     ; line of text to parse
  29. string  buffer      ; buffer for file copy
  30. integer handle      ; dos handle for bulletin list
  31. integer isblt       ; scan for bulletins?
  32. integer addblt      ; add bulletin to capture
  33. integer acount      ; count of attempted bulletins
  34. integer bcount      ; number of main board bulletins
  35. integer lcount      ; current position of seek
  36. integer handsrc     ; handle to source file
  37. integer handdst     ; handle to destination file
  38. boolean ferror      ; file error
  39. boolean cfgthere    ; found configuration file
  40. boolean cont        ; continue scanning?
  41. integer ax          ; registers for interrupts
  42. integer bx
  43. integer cx
  44. integer dx
  45. integer si
  46. integer di
  47. integer flags
  48. integer ds
  49. integer es
  50.  
  51. ;────── Main Program ────────────────────────────────────────────────────────
  52.  
  53.     let cmdline = ""
  54.     let isblt = 0
  55.     let acount = 1
  56.     let lcount = 1
  57.     let token = gettoken()
  58.     while (token != "") do
  59.        if (left(upper(token),1) = "B") then
  60.           let isblt = or(isblt,1)
  61.        else
  62.           let cmdline = cmdline + token
  63.        endif
  64.        if (left(upper(token),1) = "D") let isblt = or(isblt,2)
  65.        let token = gettoken()
  66.     endwhile
  67.  
  68.     if (isblt != 3) goto alldone
  69.  
  70. ;────── Bulletin Scan ───────────────────────────────────────────────────────
  71.  
  72.     getuser
  73.     let cnames = readline(pcbdat(),31)
  74.     let bltlst = trim(readline(cnames,25)," ")
  75.  
  76.     if (bltlst = "" | left(bltlst,1) = " ") goto alldone
  77.     if (!exist(bltlst)) goto alldone
  78.  
  79.     if (exist(ppepath()+ppename()+".cfg")) then
  80.        let cfgthere = true
  81.        let bltscan = ""
  82.        let bltscan = readline(ppepath()+ppename()+".cfg",1)
  83.     else
  84.        let cfgthere = false
  85.     endif
  86.  
  87.     let bcount = fileinf(bltlst,4) / 30
  88.  
  89.     gosub openfile
  90.     let handle = regax()
  91.     if (ferror) goto alldone
  92.  
  93.     dispstr "@X0FScanning Bulletins "
  94.  
  95.     if (cfgthere) then
  96.         while (acount <= len(bltscan) & acount <= bcount) do
  97.             if (mid(bltscan,acount,1)!="Y") goto nextcfgblt
  98.             if (lcount != acount - 1) gosub seek
  99.             dispstr "."
  100.             gosub readdata
  101.             gosub handleblt
  102.         
  103. :nextcfgblt
  104.  
  105.             inc acount
  106.         endwhile
  107.     else
  108.         while (acount <= bcount) do
  109.             if (and(acount,1)=1) dispstr "."
  110.             gosub readdata
  111.             gosub handleblt
  112.         
  113. :nextblt
  114.  
  115.             inc acount
  116.         endwhile
  117.     endif
  118.  
  119.     gosub closefile
  120.  
  121.     dispstr chr(13)
  122.  
  123.     goto alldone
  124.  
  125.  
  126. ;────── OpenFile ────────────────────────────────────────────────────────────
  127.  
  128. :OpenFile
  129.  
  130.     varseg bltlst,ds
  131.     varoff bltlst,dx
  132.     let ax = 3d20h
  133.     dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  134.     let handle = regax()
  135.     let ferror = regcf()
  136.  
  137.     return
  138.  
  139. ;────── ReadData ────────────────────────────────────────────────────────────
  140.  
  141. :ReadData
  142.  
  143.     let parseln = "                              " ; 30 spaces
  144.     let bx = handle
  145.     let ax = 3f00h
  146.     let cx = len(parseln)
  147.     varseg parseln,ds
  148.     varoff parseln,dx
  149.     dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  150.     ferror = regcf()
  151.     if (ferror | regax() = 0) let parseln = ""
  152.     let lcount = acount
  153.  
  154.     return
  155.  
  156. ;────── Seek ────────────────────────────────────────────────────────────────
  157.  
  158. :Seek
  159.  
  160.     let bx = handle
  161.     let ax = 4200h
  162.     let dx = (30 * (acount - 1)) % 1000h
  163.     let cx = (30 * (acount - 1)) / 1000h
  164.     dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  165.     ferror = regcf()
  166.  
  167.     return
  168.  
  169. ;────── CloseFile ───────────────────────────────────────────────────────────
  170.  
  171. :CloseFile
  172.  
  173.     let bx = handle
  174.     let ax = 3e00h
  175.     dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  176.     let ferror = regcf()
  177.  
  178.     return
  179.  
  180. ;────── UpdateDisp ──────────────────────────────────────────────────────────
  181.  
  182. :UpdateDisp
  183.  
  184.     inc acount
  185.     if (and(acount,1)=1) dispstr "."
  186.  
  187.     return
  188.  
  189. ;────── HandleBlt ───────────────────────────────────────────────────────────
  190.  
  191. :HandleBlt
  192.  
  193.     let bltpth = trim(parseln," ")
  194.     if (parseln = "") goto nextblt
  195.  
  196.     if (!(exist(bltpth))) goto nextblt
  197.     if (fileinf(bltpth,4)=0) goto nextblt
  198.  
  199.     let addblt = 0
  200.     if (fileinf(bltpth,2) >= u_ldate()) let addblt = or(addblt,1)
  201.     if (fileinf(bltpth,3) > u_ltime()) let addblt = or(addblt,2)
  202.     if (addblt = 3) then
  203.         let nbltpth = temppath()+fileinf(bltpth,8)+fileinf(bltpth,9)
  204.         gosub copyfile
  205.     endif
  206.  
  207.     return
  208.  
  209. ;────── CopyFile ────────────────────────────────────────────────────────────
  210.  
  211. :CopyFile
  212.  
  213.         varseg bltpth,ds
  214.         varoff bltpth,dx
  215.         let ax = 3d20h
  216.         dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  217.         if (regcf()) goto donecopy
  218.         let handsrc = regax()
  219.         varseg nbltpth,ds
  220.         varoff nbltpth,dx
  221.         let ax = 3c00h
  222.         let cx = 0000h
  223.         dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  224.         if (regcf()) then
  225.             let bx = handsrc
  226.             dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  227.             goto donecopy
  228.         endif
  229.         let handdst = regax()
  230.         let buffer = "                                "         ; 32 spaces
  231.         let buffer = buffer + buffer
  232.         let buffer = buffer + buffer
  233.         let bx = handsrc
  234.         let cx = len(buffer)
  235.         varseg buffer,ds
  236.         varoff buffer,dx
  237.         let ax = 3f00h
  238.         dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  239.         if (regcf() | regax() = 0) then
  240.             let cont = false
  241.         else
  242.             let cont = true
  243.         endif
  244.         while (cont) do
  245.             let bx = handdst
  246.             let cx = regax()
  247.             let ax = 4000h
  248.             dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  249.             let bx = handsrc
  250.             let cx = len(buffer)
  251.             let ax = 3f00h
  252.             dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  253.             if (regcf() | regax() = 0) let cont = false
  254.         endwhile
  255.         let bx = handdst
  256.         let ax = 3e00h
  257.         dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  258.         let bx = handsrc
  259.         let ax = 3e00h
  260.         dointr 21h,ax,bx,cx,dx,si,di,flags,ds,es
  261.  
  262. :DoneCopy
  263.  
  264.         return
  265.  
  266. ;────── Finished ────────────────────────────────────────────────────────────
  267.  
  268. :alldone
  269.  
  270.     kbdstuff "qwk " + cmdline + chr(13)
  271.  
  272.     end
  273.